home *** CD-ROM | disk | FTP | other *** search
/ Info-Mac 4 / Info_Mac IV CD-ROM (Pacific HiTech Inc.)(August 1994).iso / Development / General / PG PRO⁄PG Lite Demos / PG Writer π / Font.FLTR < prev    next >
Text File  |  1994-03-28  |  8KB  |  248 lines
  1. '===============================================================================
  2. '=                         Copyright 1992 Staz™ Software, Inc.                 =
  3. '=                               All rights reserved                           =
  4. '=                             "Font.INCL" from PG:PRO                         =
  5. '===============================================================================
  6. INCLUDE FILE _aplIncl
  7. COMPILE 0,_MacsbugLabels_strResource_caseInsensitive'set by PG:PRO
  8. GLOBALS "PG PRO.GLBL"'include standard global file
  9. END GLOBALS'no other globals
  10. GOTO "Font:Start"'ALWAYS jump around functions
  11. INCLUDE "@Header.INCL"
  12. DEFSTR LONG'needed for CVI's
  13. '_______________________________________________________________________________
  14. LOCAL FN checkMinstall(@theVar&)'∑œ∑∑∑∑∑∑∑∑∑∑∑∑∑∑∑∑∑∑∑∑∑∑∑∑∑œ∑
  15. '—————————————————————————————————————————————————————————————————————————————
  16. theMenuID = {theVar&}
  17. LONG IF theMenuID
  18. LONG IF FN GETMHANDLE(theMenuID) = 0
  19. % theVar&,0
  20. END IF
  21. END IF
  22. END FN
  23. '_______________________________________________________________________________
  24. LOCAL FN suggestFontSize(fNum)'∑∑œœœœœœœœœœœœœœœœœœœœœœœœœ∑∑
  25. '—————————————————————————————————————————————————————————————————————————————
  26. temp$ = STR#(_baseID - 4,2)'get name of size menu
  27. sizeMenu = FN pGfindMenu(temp$)'get menu's ID
  28. FN checkMinstall(sizeMenu)'is it installed?
  29. LONG IF sizeMenu'pG built menu?
  30. mHndl& = FN GETMHANDLE(sizeMenu)
  31. LONG IF mHndl&
  32. itemCount = FN COUNTMITEMS(mHndl&)
  33. FOR loop = 1 TO itemCount
  34. CALL GETITEM(mHndl&,loop,theItem$)
  35. theSize = VAL(theItem$)'size is value of item
  36. theMask = 0
  37. LONG IF theSize'numeric item?
  38. LONG IF FN REALFONT(fNum,theSize)'thsi size avail?
  39. theMask = _outlineBit%'use outline
  40. END IF
  41. END IF
  42. CALL SETITEMSTYLE(mHndl&,loop,theMask)
  43. NEXT
  44. END IF
  45. END IF
  46. END FN
  47. '_______________________________________________________________________________
  48. LOCAL FN autoFontMenu'∑∑œœœœœœœœœœœœœœœœœœœœœœœœœ∑∑
  49. '—————————————————————————————————————————————————————————————————————————————
  50. menuID = gWhichMenu
  51. itemID = gWhichItem
  52. mHndl& = FN GETMHANDLE(menuID)
  53. LONG IF mHndl&
  54. theTitle$ = PSTR$([mHndl&] + _menuData)
  55. SELECT theTitle$
  56. CASE STR#(_baseID - 4,1)'"Font" menu -----------------
  57. DEF CHECKONEITEM(menuID,gWhichItem)
  58. CALL GETFNUM(gItemName$,fNum)
  59. FN suggestFontSize(fNum)
  60. IF WINDOW(_EFnum) THEN EDIT TEXT fNum
  61. CASE STR#(_baseID - 4,2)'"Size" menu -----------------
  62. theSize = VAL(gItemName$)
  63. LONG IF theSize
  64. DEF CHECKONEITEM(menuID,gWhichItem)
  65. theSize = VAL(gItemName$)
  66. XELSE
  67. temp$ = STR#(_baseID - 5,1)
  68. temp$ = FN pGask$(temp$,"")
  69. theSize = VAL(temp$)
  70. IF theSize < 7 OR theSize>127 THEN theSize = 0
  71. END IF
  72. IF WINDOW(_EFnum) AND theSize>0 THEN EDIT TEXT ,theSize
  73. CASE STR#(_baseID - 4,3)'"Style" menu -----------------
  74. SELECT gWhichItem
  75. CASE 1'plain
  76. theStyle = 0
  77. EDIT TEXT ,,theStyle
  78. CASE <_justifyItem
  79. LONG IF gWhichItem > _justifyItem-4'condense/extend
  80. DEC(gWhichItem)'allow for line before items
  81. END IF
  82. theStyle = (2^(gWhichItem-3))
  83. EDIT TEXT ,,theStyle
  84. CASE ELSE
  85. LONG IF WINDOW(_EFnum)
  86. LONG IF BUTTON&(WINDOW(_EFnum))
  87. oldPos = BUTTON(WINDOW(_EFnum))
  88. XELSE
  89. oldPos = 0
  90. END IF
  91. EDIT FIELD WINDOW(_EFnum),,,,gWhichItem - _justifyItem + 1
  92. IF oldPos THEN SCROLL BUTTON WINDOW(_EFnum),oldPos
  93. END IF
  94. itemCount = FN COUNTMITEMS(mHndl&)
  95. LONG IF itemCount >_justifyItem
  96. FOR loop = _justifyItem TO itemCount
  97. CALL CHECKITEM(mHndl&,loop,(loop = gWhichItem))
  98. NEXT
  99. END IF
  100. END SELECT
  101. END SELECT
  102. END IF
  103. END FN
  104. '_______________________________________________________________________________
  105. LOCAL FN fixFontMenus'∑∑œœœœœœœœœœœœœœœœœœœœœœœœœ∑∑
  106. '—————————————————————————————————————————————————————————————————————————————
  107. DIM tsFont,tsFace,tsSize,tsColor;6
  108.  
  109. temp$ = STR#(_baseID - 4,2)'get name of size menu
  110. LONG IF LEN(temp$)
  111. sizeMenu = FN pGfindMenu(temp$)
  112. XELSE
  113. sizeMenu = 0
  114. END IF
  115. FN checkMinstall(sizeMenu)'is it installed?
  116.  
  117. temp$ = STR#(_baseID - 4,1)'get name of font menu
  118. LONG IF LEN(temp$)
  119. fontMenu = FN pGfindMenu(temp$)
  120. LONG IF fontMenu'check to see if it's a popper
  121. LONG IF FN GETMHANDLE(fontMenu) = 0
  122. fontMenu = 0
  123. END IF
  124. END IF
  125. XELSE
  126. fontMenu = 0
  127. END IF
  128. FN checkMinstall(fontMenu)'is it installed?
  129.  
  130. temp$ = STR#(_baseID - 4,3)'get name of style menu
  131. LONG IF LEN(temp$)
  132. styleMenu = FN pGfindMenu(temp$)
  133. XELSE
  134. styleMenu = 0
  135. END IF
  136. FN checkMinstall(styleMenu)'is it installed?
  137. '
  138. theField = WINDOW(_EFnum)'get current field num
  139. LONG IF theField'any active field?
  140. LONG IF WINDOW(24)>0'not a pict field
  141. theMode = _doAll
  142. boolean = FN  TECONTINUOUSSTYLE(theMode,tsFont,WINDOW(_EFHandle))
  143. :'== FONT MENU ==
  144. LONG IF fontMenu'pG built menu?
  145. DEF CHECKONEITEM(fontMenu,0)'uncheck all items
  146. LONG IF theMode AND _fontBit%'was a font continuous?
  147. FN suggestFontSize(tsFont)'outline useable sizes
  148. CALL GETFONTNAME(tsFont,temp$)'get font name for font num
  149. FN pGcheckName(fontMenu,temp$)'check this font name
  150. XELSE'no continuous font?
  151.  
  152. mHndl& = FN GETMHANDLE(sizeMenu)'handle to size menu
  153. LONG IF mHndl&
  154. itemCount = FN COUNTMITEMS(mHndl&)'number of items in menu
  155. FOR loop = 1 TO itemCount-2'loop thru
  156. CALL SETITEMSTYLE(mHndl&,loop,0)'set style to plain
  157. NEXT'till all outlines abolished
  158. END IF
  159. END IF
  160. END IF
  161. :'== SIZE MENU ==
  162. LONG IF sizeMenu'pG built menu?
  163. DEF CHECKONEITEM(sizeMenu,0)'uncheck all items
  164. LONG IF theMode AND _sizeBit%'was a size continuous?
  165. temp$ = MID$(STR$(tsSize),2)+" "+STR#(_baseID-5,3)
  166. FN pGcheckName(sizeMenu,temp$)'check the item name
  167. END IF
  168. END IF
  169. :'== STYLE MENU ==
  170. LONG IF styleMenu'pG built menu?
  171. DEF CHECKONEITEM(styleMenu,0)'uncheck all items
  172. LONG IF theMode AND _faceBit%'is a style cont. over the sel
  173. LONG IF (tsFace AND &6000) = &6000'cond & extend both checked
  174. tsFace = tsFace - &6000'clear these two bits because
  175. END IF'they cancel each otherr
  176. LONG IF tsFace = 0'is that style plain?
  177. MENU styleMenu,1,2'check "Plain" only
  178. XELSE
  179. offSet = 3'1st bit matches 3rd menu item
  180. tsFace = PEEK(@tsFace)'TextEdit only uses hi byte
  181. FOR loop = 0 TO 6'7 possible styles
  182. LONG IF tsFace AND (2^loop)'is this style bit set?
  183. MENU styleMenu,loop + offSet,2'check it
  184. END IF
  185. IF loop = 4 THEN INC(offSet)'allow for line B4 "Condense"
  186. NEXT'complete style item loop
  187. END IF'end of tsFace<>0
  188. END IF'end of continuous face
  189. :
  190. mHndl& = FN GETMHANDLE(styleMenu)
  191. LONG IF mHndl&
  192. LONG IF FN COUNTMITEMS(mHndl&) > _justifyItem
  193. justify = WINDOW(24)-1 AND 3'== JUSTIFICATION ==
  194. MENU styleMenu,justify + _justifyItem,2'check this style
  195. END IF
  196. END IF
  197. END IF
  198. '
  199. END IF
  200. '
  201. END IF
  202. END FN
  203. '_______________________________________________________________________________
  204. LOCAL FN initFonts'∑∑œœœœœœœœœœœœœœœœœœœœœœœœœ∑∑
  205. '—————————————————————————————————————————————————————————————————————————————
  206. temp$ = STR#(_baseID - 4,1)'get name of font menu
  207. LONG IF LEN(temp$)
  208. fontMenu = FN pGfindMenu(temp$)
  209. LONG IF fontMenu
  210. MENU fontMenu,-1,1,"FOND"'add all fonts
  211. CALL GETFONTNAME(1,temp$)'get application font name
  212. FN pGcheckName(fontMenu,temp$)'check it in the menu
  213. mHndl& = FN GETMHANDLE(fontMenu)
  214. LONG IF mHndl&
  215. IF {[mHndl&]} > 99 THEN CALL DELETEMENU({[mHndl&]})
  216. END IF
  217. END IF
  218. END IF
  219.  
  220. temp$ = STR#(_baseID - 4,2)'get name of size menu
  221. LONG IF LEN(temp$)'pG built menu?
  222. sizeMenu = FN pGfindMenu(temp$)
  223. FN checkMinstall(sizeMenu)'is it installed?
  224. LONG IF sizeMenu
  225. FN suggestFontSize(1)'outline proper sizes
  226. temp$ = STR#(_baseID - 5,2)'get default font size
  227. FN pGcheckName(sizeMenu,temp$)'check 12 pt. in the menu
  228. END IF
  229. END IF
  230.  
  231. END FN
  232. '_______________________________________________________________________________
  233. '€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€ FONT FILTER €€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€
  234. '———————————————————————————————————————————————————————————————————————————————
  235. "Font:Start"
  236. SELECT gAction
  237. CASE _mouseAction'pass quickly
  238. CASE _mainAction
  239. LONG IF gSubAction = _mainStart
  240. FN initFonts
  241. END IF
  242. CASE _menuAction :FN autoFontMenu
  243. CASE _otherAction
  244. LONG IF gSubAction = _otherBeforeMenu
  245. FN fixFontMenus
  246. END IF
  247. END SELECT
  248.